(FILECREATED " 2-DEC-75 14:21:21" <LENAT>SPARE2.;1 3034   

     changes to:  IN-A-LOOP SPARE2COMS)


  (LISPXPRINT (QUOTE SPARE2COMS)
	      T T)
  [RPAQQ SPARE2COMS ((FNS IN-A-LOOP)
	  (COMS * (LIST (CONS (QUOTE IFPROP)
			      (QUOTE (ALL CONSTANT-STRUC REPLACE]
(DEFINEQ

(IN-A-LOOP
  [LAMBDA (SRES)                                                                (* A Predicate to see if we are 
										currently inside a tight loop)
    [SEARCHPDL (FUNCTION (LAMBDA (N V)
		   (COND
		     ((FMEMB N LOOP-FNS)
		       (SETQ SRES T)
		       T)
		     ((IS-CON N)
		       (SETQ SRES NIL)
		       (NEQ N (QUOTE CONSTANT-STRUC)))
		     (T NIL]
    SRES])
)
  (PUTPROPS CONSTANT-STRUC WORTH (130 150 800 1000) 
                           ALGS ((TYPE NONRECURSIVE (GRAND-STRUC))
				 (TYPE PC (SOME STRUCTURE))) 
                           D-R ((ANYTHING STRUCTURE)) 
                           UP (OPERATION) 
                           GUP (OPERATION) 
                           DEFN NIL)
  (PUTPROPS REPLACE WORTH (310 400 700 500 400 990 900 1000 800 800 1000) 
                    D-R ((STRUCTURE OPERATION STRUCTURE)
			 (BAG-STRUC OPERATION BAG-STRUC)) 
                    DEFN [[TYPE NONRECURSIVE (AND (ISA BA1 (QUOTE STRUCTURE))
						  (ISA BA2 (QUOTE ACTIVE))
						  (ISA BA3 (QUOTE STRUCTURE))
						  (ARE-EQUIV BA3 (APPLYB (QUOTE REPLACE)
									 (QUOTE ALGS)
									 BA1 BA2]
			  (TYPE PC (FOREACH X IN BA1 JOIN (BA2 X] 
                    ALGS [(TYPE
			    NONRECURSIVE
			    (PROGN (SETQ GTEMP325 NIL)
				   [SETQ
				     GTEMP326
				     (MAPCONC
				       [COND ((ISA BA1 (QUOTE STRUCTURE))
					      BA1)
					     [(AND (ISA BA2 (QUOTE OPERATION))
						   (SETQ BA1
							 (RAND-MEMB
							   (APPLY* (QUOTE ACEX)
								   (CAR (SOME [ALL-BUT-LAST (ANY1OFE
											      (GETB BA2 (QUOTE D-R]
									      (FUNCTION (LAMBDA (Z)
												(ISAG Z (QUOTE 
													  STRUCTURE]
					     (T (SETQ BA1 (RAND-MEMB (ACEX STRUCTURE]
				       (COND [(ISA BA2 (QUOTE OPERATION))
					      (FUNCTION (LAMBDA (Z)
								(SETQ GTEMP325 (APPLYB BA2 (QUOTE ALGS)
										       Z))
								(